---
title: "Flex Dashboards for Sharing Results"
output:
flexdashboard::flex_dashboard:
source_code: embed
orientation: columns
theme: cosmo
editor_options:
chunk_output_type: console
---
```{r, libraries, include = FALSE}
## here to navigate project directory
library(here)
## tidyverse for data wrangling and visualization
library(tidyverse)
## snakecase for naming conventions
library(snakecase)
## flexdashboard to build dashboards in R Markdown
library(flexdashboard)
## shiny for reactive dashboards
library(shiny)
## jsonlite to import json data files
library(jsonlite)
## hexbin for hex plots
library(hexbin)
## DT for web-friendly, interactive tables
library(DT)
```
```{r, global, include = FALSE}
### import data objects
## use read_json() to import the data file
airline <- read_json(
## use here() to locate file in our project directory
here(
# folder
"data",
# file
"airline.json"
),
## turn into data table
simplifyVector = TRUE
)
### rename variables, convert variables
## overwrite
airline <- airline %>%
## convert to tibble
as_tibble() %>%
## mutate variable types and values
mutate(
## characters to factors
across(
# find character variables
.cols = where(is.character),
# convert to factors
.fns = as_factor
),
## relevel
Class = fct_relevel(
# factor
Class,
# level
"Business",
# position
after = 2
)
) %>%
## clean variable names
rename_with(
# function
.fn = to_snake_case
)
```
```{css, echo = FALSE}
/* adjust height of data tables */
.dataTables_scrollBody {
/* adjust height */
max-height: 100% !important;
}
```
```{r, gauge_compute, include = FALSE}
### display table
## call data
gauge_compute <- airline %>%
## groups
group_by(
# travel
travel_type
) %>%
## compute summaries
summarize(
# count
count = n(),
# mean recommendation
mean_recommend = format(
# round
round(
# average
mean(recommendation),
# decimals
digits = 2
),
# decimals
nsmall = 2
),
# remove groups
.groups = "drop"
)
```
Plots
================
Column {.tabset .tabset-fade}
-----------------------------------------------------------------------
### Violin Plot
```{r, plot_1}
### violin plot
## call data and mapping
ggplot(
# data
airline,
# mapping
aes(
# x-axis
x = customer_type,
# y-axis
y = recommendation,
# fill
fill = class
)
) +
## violin geometry
geom_violin() +
## labels
labs(
# x-axis
x = "Customer Type",
# y-axis
y = "Recommendation",
# fill
fill = "Class"
)
```
### Hex Bin Plot
```{r, plot_2}
### hex plot
## call data and mapping
ggplot(
# data
airline,
# mapping
aes(
# x-axis
x = age,
# y-axis
y = recommendation
)
) +
## hex geometry
geom_hex() +
## labels
labs(
# x-axis
x = "Age",
# y-axis
y = "Recommendation",
# fill
fill = "Count"
)
```
### Heat Map
```{r, plot_3}
### heat map
## call data and mapping
ggplot(
# data
airline,
# mapping
aes(
# x-axis
x = leg_room,
# y-axis
y = cleanliness,
# fill
fill = recommendation
)
) +
## tile geometry
geom_tile() +
## adjust fill color
scale_fill_gradient2(
# low value color
low = "blue",
# mid value color
mid = "white",
# high value color
high = "red",
# midpoint
midpoint = 50
) +
## labels
labs(
# x-axis
x = "Leg Room",
# y-axis
y = "Cleanliness",
# fill
fill = "Recommendation"
)
```
### 2D Density Plot
```{r, plot_4}
### filled 2d density
## call data and mapping
ggplot(
# data
airline,
# mapping
aes(
# x-axis
x = flight_distance,
# y-axis
y = recommendation
)
) +
## tile geometry
geom_density_2d_filled(
# contours
contour_var = "ndensity"
) +
## facet
facet_grid(
# rows by columns
customer_type ~ class
) +
## labels
labs(
# x-axis
x = "Flight Distance",
# y-axis
y = "Recommendation",
# fill
fill = "Density"
)
```
Table 1 {data-navmenu=Tables}
================
Column
-----------------------------------------------------------------------
### Younger Female Customers
```{r, table_1}
### filtered table
## save
tab_1 <- airline %>%
## filter for rows
filter(
# condition
age <= 30,
# condition
gender == "Female"
) %>%
## select columns
select(
# filter variables
age, gender,
# other characteristics
customer_type, travel_type:flight_distance,
# measures
inflight_wi_fi:recommendation
)
### display table
## datatable
datatable(
# data
tab_1,
# remove row names
rownames = FALSE,
# filter
filter = "top",
# add buttons
extensions = "Scroller",
# options
options = list(
# table, length, pagination, scrolling
dom = "tlpS",
# scroller
scrollY = "200px",
# number of rows
pageLength = 25
)
)
```
Table 2 {data-navmenu=Tables}
================
Column
-----------------------------------------------------------------------
### Older Female Customers
```{r, table_2}
### filtered table
## save
tab_2 <- airline %>%
## filter for rows
filter(
# condition
age > 30,
# condition
gender == "Female"
) %>%
## select columns
select(
# filter variables
age, gender,
# other characteristics
customer_type, travel_type:flight_distance,
# measures
inflight_wi_fi:recommendation
)
### display table
## datatable
datatable(
# data
tab_2,
# remove row names
rownames = FALSE,
# filter
filter = "top",
# add buttons
extensions = "Scroller",
# options
options = list(
# table, length, pagination, scrolling
dom = "tlpS",
# scroller
scrollY = "200px",
# number of rows
pageLength = 25
)
)
```
Gauges
================
Column
-----------------------------------------------------------------------
### Personal Travel Customers
```{r, box_1}
### value box
## call function
valueBox(
## data
gauge_compute %>%
## filter
filter(
# condition
travel_type == "Personal Travel"
) %>%
## extract value
pull(count),
# caption
caption = "Number of Personal Travel Customers",
# icon
icon = "fa-chart-bar"
)
```
### Average Recommendation of Personal Travel Customers
```{r, gauge_1}
### gauge
## call function
gauge(
## data
gauge_compute %>%
## filter
filter(
# condition
travel_type == "Personal Travel"
) %>%
## extract value
pull(mean_recommend),
## minimum and maximum
min = 0, max = 100,
## sectors
sectors = gaugeSectors(
# green
success = c(75, 100),
# orange
warning = c(50, 74),
# red
danger = c(0, 49)
)
)
```
Column
-----------------------------------------------------------------------
### Business Travel Customers
```{r, box_2}
### value box
## call function
valueBox(
## data
gauge_compute %>%
## filter
filter(
# condition
travel_type == "Business Travel"
) %>%
## extract value
pull(count),
# caption
caption = "Number of Business Travel Customers",
# icon
icon = "fa-chart-bar"
)
```
### Average Recommendation of Business Travel Customers
```{r, gauge_2}
### gauge
## call function
gauge(
## data
gauge_compute %>%
## filter
filter(
# condition
travel_type == "Business Travel"
) %>%
## extract value
pull(mean_recommend),
## minimum and maximum
min = 0, max = 100,
## sectors
sectors = gaugeSectors(
# green
success = c(75, 100),
# orange
warning = c(50, 74),
# red
danger = c(0, 49)
)
)
```
Storyboard {.storyboard}
================
### Younger Female Customers Clustered by Satisfaction and Recommendation
```{r, clusters_1}
cluster_1 <- airline %>%
filter(age <= 30, gender == "Female") %>%
select(recommendation, satisfaction)
set.seed(123) # Set seed for reproducibility
kmeans_cluster_1 <- kmeans(cluster_1, centers = 3, nstart = 25)
cluster_1 <- cluster_1 %>%
mutate(cluster = factor(kmeans_cluster_1$cluster))
ggplot() +
# First geom_point layer with cluster_1 data
geom_point(data = cluster_1, aes(x = satisfaction, y = recommendation, color = cluster), size = 2) +
# Second geom_point layer with cluster centers
geom_point(data = as_tibble(kmeans_cluster_1$centers), aes(x = satisfaction, y = recommendation, color = factor(1:3)),
size = 4, shape = 4, stroke = 4) +
# Label the axes and legend
labs(x = "Satisfaction", y = "Recommendation", color = "Cluster") +
# Update the theme
theme(legend.position = "bottom")
```
***
We create three clusters of **younger female customers** as a function of their flight satisfaction and recommendation.
We see the clusters defined by either low, medium, or high values on both variables.
Next step requires investigating what we do well to make these customers satisfied and willing to recommend our airline.
### Older Female Customers Clustered by Satisfaction and Recommendation
```{r, cluster_2}
cluster_2 <- airline %>%
filter(age > 30, gender == "Female") %>%
select(recommendation, satisfaction)
set.seed(123) # Set seed for reproducibility
kmeans_cluster_2 <- kmeans(cluster_2, centers = 3, nstart = 25)
cluster_2 <- cluster_2 %>%
mutate(cluster = factor(kmeans_cluster_2$cluster))
ggplot() +
# First geom_point layer with cluster_2 data
geom_point(data = cluster_2, aes(x = satisfaction, y = recommendation, color = cluster), size = 2) +
# Second geom_point layer with cluster centers
geom_point(data = as_tibble(kmeans_cluster_2$centers), aes(x = satisfaction, y = recommendation, color = factor(1:3)),
size = 4, shape = 4, stroke = 4) +
# Label the axes and legend
labs(x = "Satisfaction", y = "Recommendation", color = "Cluster") +
# Update the theme
theme(legend.position = "bottom")
```
***
We create three clusters of **older female customers** as a function of their flight satisfaction and recommendation.
We see the clusters defined by either low, medium, or high values on both variables.
Next step requires investigating what we do well to make these customers satisfied and willing to recommend our airline.
